home *** CD-ROM | disk | FTP | other *** search
/ ASME's Mechanical Engine…ing Toolkit 1997 December / ASME's Mechanical Engineering Toolkit 1997 December.iso / ai / prlg195b.lzh / GAMES.LZH / CHESSKRK.PRO next >
Text File  |  1986-11-01  |  13KB  |  499 lines
  1.  
  2. /*  King - Rook - King endgame. Adapted from:         */
  3.  
  4.   "Prolog Programming for Artificial Intelligence"           */
  5. /*                     by Ivan Bratko       (pp 370-386)         */
  6.  
  7. /*    The name of the contributor will remain confidential for   */
  8. /* now.                                                          */
  9.  
  10.  
  11.  
  12. /*  - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -  */
  13.  
  14. /*   A miniature implementation of Advice Language 0           */
  15.         
  16. /*   This program plays a game from a given starting position  */
  17. /* using knowledge represented in Advice Language 0            */
  18.  
  19. ?- op(200,xfy,': ').
  20. ?- op(220,xfy,'.. ').
  21. ?- op(185,fx,'if ').
  22. ?- op(190,xfx,'then ').
  23. ?- op(180,xfy,'or ').
  24. ?- op(160,xfy,'and ').
  25. /*  ?- op(140,fx,'not ').  */
  26.    
  27. it(X) :- X = (w .. 4 : 5 .. 5 : 3 .. 3 : 7 .. 0).
  28.  
  29.  
  30. /*   Play a game starting in Pos   */
  31.  
  32. /*   Start with empty forcing-tree  */
  33.  
  34. play(Pos) :-
  35.        playgame(Pos,nil).
  36.   
  37. playgame(Pos,ForcingTree) :-
  38.        show(Pos),
  39.        (end_of_game(Pos),
  40.           print('End of game'), nl,!;
  41.        playmove(Pos,ForcingTree,Pos1,ForcingTree1), !,
  42.           playgame(Pos1,ForcingTree1) ).
  43.  
  44. /*   Play 'us' move according to forcing-tree.  */
  45.  
  46. playmove(Pos,Move .. FTree1,Pos1,FTree1) :-
  47.        side(Pos,w),
  48.        legalmove(Pos,Move,Pos1),
  49.        showmove(Move).
  50.  
  51. /*   Read 'them' move.     */
  52.  
  53. playmove(Pos,FTree,Pos1,FTree1) :-
  54.       side(Pos,b),
  55.       print('Your move: '),
  56.       read(Move),
  57.        (legalmove(Pos,Move,Pos1),
  58.        subtree(FTree,Move,FTree1), ! ;
  59.        print('Illegal move '), nl,
  60.        playmove(Pos,FTree,Pos1,FTree1) ).
  61.  
  62. /*   If current forcing-tree is empty, generate a new one.  */
  63.  
  64. playmove(Pos,nil,Pos1,FTree1) :-
  65.        side(Pos,w),
  66.        resetdepth(Pos,Pos0),
  67.        strategy(Pos0,FTree), !,
  68.           playmove(Pos0,FTree,Pos1,FTree1).
  69.  
  70. /*   Select a forcing-subtree corresponding to Move.   */
  71.  
  72. subtree(FTrees,Move,FTree) :-
  73.        member(Move .. FTree,FTrees), !.
  74.  
  75. subtree(_,_,nil).
  76.  
  77. strategy(Pos,ForcingTree) :-
  78.        Rule :  if Condition then AdviceList,
  79.        holds(Condition,Pos,_), !,
  80.        member(AdviceName,AdviceList),
  81.           nl, print('Trying '), print(AdviceName),
  82.           satisfiable(AdviceName,Pos,ForcingTree), !.
  83.  
  84. satisfiable(AdviceName,Pos,FTree) :-
  85.        advice(AdviceName,Advice),
  86.        sat(Advice,Pos,Pos,FTree).
  87.  
  88. sat(Advice,Pos,RootPos,FTree) :-
  89.        holdinggoal(Advice,HG),
  90.        holds(HG,Pos,RootPos),
  91.        sat1(Advice,Pos,RootPos,FTree).
  92.   
  93. sat1(Advice,Pos,RootPos,nil) :-
  94.        bettergoal(Advice,BG),
  95.        holds(BG,Pos,RootPos), !.
  96. sat1(Advice,Pos,RootPos,Move .. FTrees) :-
  97.        side(Pos,w), !,
  98.           usmoveconstr(Advice,UMC),
  99.           move(UMC,Pos,Move,Pos1),
  100.           sat(Advice,Pos1,RootPos,FTrees).
  101. sat1(Advice,Pos,RootPos,FTrees) :-
  102.        side(Pos,b), !,
  103.           themmoveconstr(Advice,TMC),
  104.           findall(Move .. Pos1,move(TMC,Pos,Move,Pos1), MPlist),
  105.           unique([],MPlist,MPlist1),
  106.           not(empty(MPlist1)),
  107.           satall(Advice,MPlist1,RootPos,FTrees).
  108.   
  109.  
  110. satall(_,[],_,[]).
  111. satall(Advice,[Move .. Pos|MPlist],RootPos,[Move .. FT|MFTs]) :-
  112.        sat(Advice,Pos,RootPos,FT),
  113.        satall(Advice,MPlist,RootPos,MFTs).
  114.  
  115. /*   Interpreting holding and bettergoals:       */
  116. /*     A goal is an AND/OR/NOT combination of predicate names.  */
  117.  
  118. holds(Goal1 and Goal2, Pos,RootPos) :-
  119.        !,
  120.           holds(Goal1,Pos,RootPos),
  121.           holds(Goal2,Pos,RootPos).
  122.  
  123. holds(Goal1 or Goal2,Pos,RootPos) :-
  124.        !,
  125.            (holds(Goal1,Pos,RootPos) ;
  126.             holds(Goal2,Pos,RootPos) ).
  127. holds(not(Goal),Pos,RootPos) :-
  128.        !,
  129.            not(holds(Goal,Pos,RootPos)).
  130. holds(Pred,Pos,RootPos) :-
  131.        Pred(Pos) ;
  132.        Pred(Pos,RootPos).
  133.   
  134.   
  135.      
  136. /*   Interpreting move constraints.    */
  137.  
  138. move(MC1 and MC2,Pos,Move,Pos1) :-
  139.        !,
  140.           move(MC1,Pos,Move,Pos1),
  141.           move(MC2,Pos,Move,Pos1).
  142. move(MC1 then MC2,Pos,Move,Pos1) :-
  143.        !,
  144.          (move(MC1,Pos,Move,Pos1) ;
  145.          move(MC2,Pos,Move,Pos1) ).
  146.      
  147.  
  148. /*   Selectors for components of piece-of-advice.   */
  149.  
  150. bettergoal(BG : _,BG).
  151.  
  152. holdinggoal(BG : HG : _,HG).
  153.  
  154. usmoveconstr(BG : HG : UMC : _,UMC).
  155.  
  156. themmoveconstr(BG : HG : UMC : TMC, TMC).
  157.  
  158. next([],L,L).
  159. next([X|L1],L2,[X|L3]) :- next(L1,L2,L3).
  160.        
  161. findall(X,Goal,Xlist) :-
  162.        Goal,
  163.        assertz(stack(X)),
  164.        fail.
  165. findall(X,Goal,Xlist) :-
  166.        assertz(stack(bottom)),
  167.        collect(Xlist).
  168.  
  169. collect(L) :-
  170.        retract(stack(X)), !,
  171.           collect1(L,X).
  172.   
  173. collect1([],X) :-
  174.        X == bottom, !.
  175. collect1(L,X) :-
  176.        L = [X|Rest],
  177.        collect(Rest).
  178.  
  179. unique([],X,X).
  180. unique([H|T],L,X) :-
  181.        not(member(H,L)),
  182.        unique(T,[H|L],X).
  183. unique([H|T],L,X) :-
  184.        member(H,L),
  185.        unique(T,L,X).
  186.  
  187. empty([]).
  188.  
  189.  
  190.  
  191.  
  192. /*   King & Rook vs. King in Advice Language 0.     */
  193.  
  194. /*   Rules                                          */
  195.  
  196.  edge_rule : if    their_king_edge and kings_close
  197.             then [ mate_in_2, squeeze, approach, keeproom,
  198.                    divide_in_2, divide_in_3 ].
  199.  
  200.  else_rule : if    true
  201.             then [ squeeze, approach, keeproom,
  202.                    divide_in_2, divide_in_3 ].
  203.  
  204. /*   Pieces-of-advice.                              */
  205.  
  206. advice(mate_in_2,
  207.        mate : 
  208.        not(rooklost) and their_king_edge : 
  209.        ( depth = 0 ) and legal then ( depth = 2 ) and checkmove : 
  210.        (depth = 1 ) and legal ).
  211.  
  212. advice(squeeze,
  213.        newroomsmaller and not(rookexposed) and 
  214.        rookdivides and not(stalemate) : 
  215.        not(rooklost) : 
  216.        ( depth = 0 ) and rookmove : 
  217.        nomove ).
  218.  
  219. advice( approach,
  220.         okapproachedcsquare and not(rookexposed) and 
  221.         ( rookdivides or lpatt ) and ( roomgt2 or not(our_king_edge)) : 
  222.         not(rooklost) : 
  223.         ( depth = 0 ) and kingdiagfirst : 
  224.         nomove ).
  225.  
  226. advice( keeproom,
  227.         themtomove and not(rookexposed) and rookdivides and okorndle and 
  228.         ( roomgt2 or not(our_king_edge) ) : 
  229.         not(rooklost) : 
  230.         ( depth = 0 ) and kingdiagfirst : 
  231.         nomove ).
  232.  
  233. advice( divide_in_2,
  234.         themtomove and rookdivides and not(rookexposed) : 
  235.         not(rooklost) : 
  236.         ( depth < 3 ) and legal : 
  237.         ( depth < 2 ) and legal ).
  238.  
  239. advice( divide_in_3,
  240.         themtomove and rookdivides and not(rookexposed) : 
  241.         not(rooklost) : 
  242.         ( depth < 5 ) and legal : 
  243.         ( depth < 4 ) and legal ).
  244.  
  245.  
  246.  
  247.  
  248.  
  249. /*   Predicate library for King & Rook vs. King.          */
  250.  
  251. /*   Position is represented by :                           */
  252. /*          Side .. Wx : Wy .. Rx : Ry .. Bx : By .. Depth  */
  253. /*                                                          */
  254. /*   Side is side to move ('w' or 'b').                     */
  255. /*   Wx, Wy are X- and Y-coordinates of White King.         */
  256. /*   Rx, Ry are X- and Y-coordinates of White Rook.         */
  257. /*   Bx, By are X- and Y-coordinates of Black King.         */
  258. /*   Depth is depth of position in search tree.             */
  259. /*                                                          */
  260.  
  261.  
  262. /*   Selector relations.           */
  263.  
  264. side(Side .. _,Side).
  265.  
  266. wk(_ .. WK .. _, WK).
  267.  
  268. wr(_ .. _ .. WR .. _, WR).
  269.  
  270. bk(_ .. _ .. _ .. BK .. _, BK).
  271.  
  272. depth(_ .. _ .. _ .. _ .. Depth, Depth).
  273.  
  274. resetdepth(S .. W .. R .. B .. D,S .. W .. R .. B .. 0).
  275.  
  276. /*   Some relations between squares.     */
  277.  
  278. n(N,N1) :-
  279.        (N1 is N + 1 ;
  280.        N1 is N - 1),
  281.        in(N1).
  282.  
  283. in(N) :-
  284.        N > 0,
  285.        N < 9.
  286.  
  287. diagngb(X : Y,X1 : Y1) :-
  288.        n(X,X1),
  289.        n(Y,Y1).
  290.  
  291. verngb(X : Y,X : Y1) :-
  292.        n(Y,Y1).
  293.  
  294. horngb(X : Y,X1 : Y) :-
  295.        n(X,X1).
  296.  
  297. ngb(S,S1) :-
  298.        diagngb(S,S1) ;
  299.        horngb(S,S1) ;
  300.        verngb(S,S1).
  301.  
  302. end_of_game(Pos) :-
  303.        mate(Pos).
  304.  
  305. /*   Move-constraints predicates.             */
  306. /*   These are specialized move generators :  */
  307. /*      move(MoveConstr,Pos,Move,NewPos)      */
  308. /*                                            */
  309.  
  310. move(depth < Max, Pos,Move,Pos1) :-
  311.        depth(Pos,D),
  312.        D < Max, !.
  313. move(depth = D, Pos,Move,Pos1) :-
  314.        depth(Pos,D), !.
  315. move(kingdiagfirst,w .. W .. R .. B .. D,W-W1,b .. W1 .. R .. B .. D1) :-
  316.        D1 is D + 1,
  317.        ngb(W,W1),
  318.        not(ngb(W1,B)),
  319.        W1 \== R.
  320. move(rookmove,w .. W .. Rx : Ry .. B .. D,(Rx : Ry)-R,b .. W .. R .. B .. D1) :-
  321.        D1 is D + 1,
  322.        coord(I),
  323.        (R = (Rx : I) ; R = (I : Ry) ),
  324.        R \== (Rx : Ry),
  325.        not(inway(Rx : Ry,W,R)).
  326. move(checkmove,Pos,R-(Rx : Ry),Pos1) :-
  327.        wr(Pos,R),
  328.        bk(Pos,Bx : By),
  329.        (Rx = Bx ; Ry = By),
  330.        move(rookmove,Pos,R-(Rx : Ry),Pos1).
  331. move(legal,w .. P,M,P1) :-
  332.        (MC = kingdiagfirst ; MC = rookmove),
  333.        move(MC,w .. P,M,P1).
  334. move(legal,b .. W .. R .. B .. D,B-B1,w .. W .. R .. B1 .. D1) :-
  335.        D1 is D + 1,
  336.        ngb(B,B1),
  337.        not(check(w .. W .. R .. B1 .. D1)).
  338.  
  339. legalmove(Pos,Move,Pos1) :-
  340.        move(legal,Pos,Move,Pos1).
  341.  
  342. check(_ .. W .. Rx : Ry .. Bx : By .. _) :-
  343.        ngb(W,Bx : By) ;
  344.        (Rx = Bx ; Ry = By),
  345.        (Rx : Ry) \== (Bx : By),
  346.        not(inway(Rx : Ry,W,Bx : By)).
  347.  
  348. inway(S,S1,S1) :- 
  349.        !.
  350. inway(X1 : Y,X2 : Y,X3 : Y) :-
  351.        ordered(X1,X2,X3), !.
  352. inway(X : Y1,X : Y2,X : Y3) :-
  353.        ordered(Y1,Y2,Y3).
  354.  
  355. ordered(N1,N2,N3) :-
  356.        N1 < N2, N2 < N3 ;
  357.        N3 < N2, N2 < N1.
  358.  
  359. coord(1).
  360. coord(2).
  361. coord(3).
  362. coord(4).
  363. coord(5).
  364. coord(6).
  365. coord(7).
  366. coord(8).
  367.  
  368. /*   Goal predicates.    */
  369.  
  370.  
  371. themtomove(b .. _).
  372.  
  373. mate(Pos) :-
  374.        side(Pos,b),
  375.        check(Pos),
  376.        not(legalmove(Pos,_,_)).
  377.  
  378. stalemate(Pos) :-
  379.        side(Pos,b),
  380.        not(check(Pos)),
  381.        not(legalmove(Pos,_,_)).
  382.  
  383. newroomsmaller(Pos,RootPos) :-
  384.        room(Pos,Room),
  385.        room(RootPos,RootRoom),
  386.        Room < RootRoom.
  387.   
  388. rookexposed(Side .. W .. R .. B .. _) :-
  389.        dist(W,R,D1),
  390.        dist(B,R,D2),
  391.        (Side = w, !, D1 > D2 + 1 ;
  392.        Side = b, !, D1 > D2 ).
  393.      
  394. okapproachedcsquare(Pos,RootPos) :-
  395.        okcsquaremdist(Pos,D1),
  396.        okcsquaremdist(RootPos,D2),
  397.        D1 < D2.
  398.  
  399. okcsquaremdist(Pos,Mdist) :-
  400.        wk(Pos,WK),
  401.        cs(Pos,CS),
  402.        manhdist(WK,CS,Mdist).
  403.  
  404. rookdivides(_ .. Wx : Wy .. Rx : Ry .. Bx : By .. _) :-
  405.        ordered(Wx,Rx,Bx), ! ;
  406.        ordered(Wy,Ry,By).
  407.  
  408. lpatt(_ .. W .. R .. B .. _) :-
  409.        manhdist(W,B,2),
  410.        manhdist(R,B,3).
  411.  
  412. okorndle(_ .. W .. R .. _,_ .. W1 .. R1 .. _) :-
  413.        dist(W,R,D),
  414.        dist(W1,R1,D1),
  415.        D =< D1.
  416.  
  417. roomgt2(Pos) :-
  418.        room(Pos,Room),
  419.        Room > 2.
  420.  
  421. our_king_edge(_ .. X : Y .. _) :-
  422.        (X = 1, ! ; X = 8, ! ; Y = 1, ! ; Y = 8).
  423.  
  424. their_king_edge((_ .. W .. R .. X : Y .. _)) :-
  425.        (X = 1, ! ; X = 8, ! ; Y = 1, ! ; Y = 8).
  426.  
  427. kings_close(Pos) :-
  428.        wk(Pos,WK),
  429.        bk(Pos,BK),
  430.        dist(WK,BK,D),
  431.        D < 4.
  432.  
  433. rooklost(_ .. W .. B .. B .. _).
  434. rooklost(b .. W .. R .. B .. _) :-
  435.        ngb(B,R),
  436.        not(ngb(W,R)).
  437.  
  438. dist(X : Y,X1 : Y1,D) :-
  439.        absdiff(X,X1,Dx),
  440.        absdiff(Y,Y1,Dy),
  441.        max(Dx,Dy,D).
  442.  
  443. absdiff(A,B,D) :-
  444.        A > B, !,
  445.        D is A-B ;
  446.        D is B-A.
  447.  
  448. max(A,B,M) :-
  449.        A >= B, !,
  450.        M = A ;
  451.        M = B.
  452.  
  453.  
  454.  
  455. manhdist(X : Y,X1 : Y1,D) :-
  456.        absdiff(X,X1,Dx),
  457.        absdiff(Y,Y1,Dy),
  458.        D is Dx + Dy.
  459.  
  460.  
  461. room(Pos,Room) :-
  462.        wr(Pos,Rx : Ry),
  463.        bk(Pos,Bx : By),
  464.        (Bx < Rx, SideX is Rx - 1 ; Bx > Rx, SideX is 8 - Rx),
  465.        (By < Ry, SideY is Ry - 1 ; By > Ry, SideY is 8 - Ry),
  466.        Room is SideX * SideY, ! ;
  467.        Room is 64.
  468.   
  469. cs(_ .. W .. Rx : Ry .. Bx : By .. _,Cx : Cy) :-
  470.        (Bx < Rx, !, Cx is Rx - 1 ; Cx is Rx + 1),
  471.        (By < Ry, !, Cy is Ry - 1 ; Cy is Ry + 1).
  472.   
  473.  
  474. /*   Display procedures.      */
  475.  
  476.   
  477. show(Pos) :-
  478.        nl,
  479.        coord(Y), nl,
  480.        coord(X),
  481.        writepiece(X : Y,Pos),
  482.        fail.
  483. show(Pos) :-
  484.        side(Pos,S),
  485.        depth(Pos,D),
  486.        nl, print(' Side= '),
  487.        print(S),
  488.        print(' Depth= '),
  489.        print(D), nl.
  490.  
  491. writepiece(Square,Pos) :-
  492.        wk(Pos,Square), !, print(' W') ;
  493.        wr(Pos,Square), !, print(' R') ;
  494.        bk(Pos,Square), !, print(' B') ;
  495.        print(' .').
  496.  
  497. showmove(Move) :-
  498.        nl, print(Move), nl.
  499.